Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / pq2par.pas < prev next >

Wrap

Pascal/Delphi Source File | 1988-08-16 | 40.6 KB | 1,322 lines

module KermitParameters; exports imports KermitGlobals from KermitGlobals; imports MenuUtils from MenuUtils; imports FileDefs from FileDefs; const MaxParts = 30; { NBNBNB!! These type definitions MUST ALWAYS correspond to the sequence of the menu items in the Kermit.MENU file } type MainCommType = (NoMainComm, MainHelp, MainSend, MainReceive, MainGet, MainExit, MainQuit, MainPush, MainTake, MainConnect, MainBye, MainFinish, MainRemote, MainLocal, MainServer, MainSet, MainShow, MainStatus, MainUsage, MainNotFound, MainNotUnique, MainEmptyLine, MainSwitch, MainIllegChar); TermCommType = (NoTermComm, TermHelp, TermQuit, TermSetBaud, TermSetStop, TermSetParity, TermSaveFile, TermOnSave, TermOffSave, TermOnXonXoff, TermOffXonXoff); SetCommType = (NoSetComm, SetHelp, SetBaud, SetParity, SetStop, SetSend, SetReceive, SetFileHeader, Set8BitQuote, SetUse8BitQuote, SetRepFix, SetUseRepFix, SetFileWarning, SetRetry, SetLogFile, SetLog, SetDebugging, SetBreakTime, SetEscape, SetNotFound, SetNotUnique, SetEmptyLine, SetSwitch, SetIllegChar); SendRecType = (NoSendRec, SRHelp, SRPacketLength, SRCtlQuote, SRStartOfPacket, SRTimeOut, SREndOfLine, SRPadding, SRPadChar); FHeaderType = (NoFHeader, FHHelp, FHNord, FHNoTrunc, FHTrunc, FHTrans); TransType = (NoTrans, TransHelp, TransLower, TransUpper, TransOff); RetryType = (NoRetryType, RetryHelp, RetryInitial, RetryPacket, RetryCommand); OnOffType = (NoOnOff, OnOffHelp, On, Off, OnOfNotFound, OnOfNotUnique, OnOfEmptyLine, OnOfSwitch, OnOfIllegChar); EmptyType = (NoEmpty, EmptyHelp, EmptyAndVoid, EmpNotFound, EmpNotUnique, EmptyLine, EmptySwitch, EmptyIllegChar); SpeedType = (NoSpeed, SpHelp, Sp110, Sp150, Sp300, Sp600, Sp1200, Sp2400, Sp4800, Sp9600, SpNotFound, SpNotUnique, SpEmptyLine, SpSwitch, SpIllegChar); ParityType = (NoParComm, ParHelp, NoKParity, EvenKParity, OddKParity, MarkKParity, SpaceKParity, ParNotFound, ParNotUnique, ParEmptyLine, ParSwitch, ParIllegChar); StopType = (NoStopComm, StopHelp, SyncrCmd, Stop1Cmd, Stop1x5Cmd, Stop2Cmd, StopNotFound, StopNotUnique, StopEmptyLine, StopSwitch, StopIllegChar); TruncPart = 1..MaxParts; TListType = array [TruncPart] of integer; const NMainComm = ord(MainNotFound)-1; NTermComm = ord(TermOffXonXoff); NSetComm = ord(SetNotFound)-1; NOnOff = ord(OnOfNotFound)-1; NSpeeds = ord(SpNotFound)-1; NParityComm = ord(ParNotFound)-1; NStopComm = ord(StopNotFound)-1; NEmptyComm = ord(EmpNotFound)-1; var RootMenu : pMenuEntry; { Pointer to root of menu structure } Parity : ParityType; { Current parity setting } Baud : SpeedType; { Current baud rate setting } StopBits : StopType; { Current number of stop bits } SendSOH : char; { Start-Of-Packet to send } SendPSize : integer; { Packet size he wants } SendTimeOut : integer; { Time-out he wants } SendNPad : integer; { Number of padding-characters he wants } SendPadChar : char; { The padding character he wants } SendEOL : char; { The EOL he wants } SendQuote : char; { The Quote char he wants } RecSOH : char; { Start-Of-Packet I want } RecPSize : integer; { Max packet size I can handle } RecTimeOut : integer; { time-out I want } RecNPad : integer; { Padding I want } RecPadChar : char; { Padchar I want } RecEOL : char; { End-Of-Line I propose } RecQuote : char; { Control quote I propose } Use8Quote : boolean; { Is 8-bit quoting in use? } Bit8Quote : char; { 8-bit Quote character to be used } UseRepFix : boolean; { Is repeat prefixing in use? } RepFix : char; { Repeat prefix to be used } NowUse8Quote, NowUseRepFix : boolean; { - enabled during this transfer?? } Debug : boolean; { Enable debug output } FileWarning : boolean; { Avoid overwriting existing file if TRUE} XonXoff : boolean; { use XonXoff handshaking } FileSave : boolean; { Log terminal session to file } SaveFile : PathName; Nord : boolean; { Translate file names for NORD } NumTrunc, OldTrunc : integer; { Truncation list } TruncList : TListType; Translate : TransType; { Case translation } MaxTryPack : Integer; { Retry limits before giving up } MaxTryInit : Integer; MaxTryComm : Integer; LongWait : Integer; LocalKermit : boolean; { Is this Kermit a local one? } DisableTimOut : boolean; { TRUE if timeout is disabled } Idev,Odev : integer; { Which devices to use for line } LegalPackets, { valid packet types } CtlMapping, { Control character mapping } OkQuote, { Valid quote characters } Quotes : set of char; { Quotes presently in use } EscKey : char; { Char to type to escape CONNECT } procedure SetInitPars( var Pack : Packet ); procedure ReadPars ( VAR Pack : Packet ); procedure InitParameters; procedure CleanupParameters; procedure SetCommand( PList : pPListEntry ); procedure ShowCommand( PList : pPListEntry ); procedure StatusCommand; procedure ShowKey( Ch : char ); {================} private {=================} imports KermitLineIO from KermitLineIO; imports KermitConnect from KermitConnect; imports IOErrors from IOErrors; imports IO_Unit from IO_Unit; imports IO_Others from IO_Others; exception NotInt; procedure EatSpaces( var S : String ); begin if S<>'' then while (S[1]=' ') and (length(S)>1) do Delete( S, 1, 1); if S=' ' then S := ''; end; function StrToInt( VAR S : String ):integer; var I :integer; done : boolean; begin I := 0; done := false; EatSpaces( S ); if S='' then raise NotInt else begin if not (S[1] in ['0'..'9']) then raise NotInt else repeat if not (S[1] in ['0'..'9']) then done := true else begin I := I*10 + ord(S[1]) - ord('0'); Delete( S, 1, 1); Done := S=''; end; until done; end; StrToInt := I; end; function CtrlChar( S:String ):integer; handler NotInt; begin CtrlChar := -1; exit( CtrlChar ); end; var R : integer; begin if length( S )=0 then R := -1 else if length( S )=1 then R := ord( S[1] ) else if S[1]='#' then begin Delete( S, 1, 1); R := StrToInt( S ); end else if S[1]='^' then if S[2] in ['@'..'^'] then R := ord( Ctl(S[2]) ) else R := -1; CtrlChar := R; end; procedure DoSetRetry( PList : pPListEntry ); var Val : integer; handler NotInt; begin writeln('Number of retries not numeric!'); exit( DoSetRetry ); end; begin Val := StrToInt( PList^.NextPList^.Arg ); if not (Val in [1..30]) then writeln('Illegal number of retries!') else case recast( PList^.Selection, RetryType ) of RetryInitial: MaxTryInit := Val; RetryPacket: MaxTryPack := Val; RetryCommand: MaxTryComm := Val; otherwise: ; end; end; procedure SetPSize( Arg : String; var PSize : integer ); var Val : integer; handler NotInt; begin writeln('Packet length not numeric!'); exit( SetPSize ); end; begin Val := StrToInt( Arg ); if not (Val in [10..94]) then writeln( 'Illegal packet length!') else PSize := Val; end; procedure SetQuote( Arg : String; var Quote : char ); var Val : integer; begin Val := CtrlChar( Arg ); if Val=-1 then writeln( 'Control quote ordinal value is not numeric!' ) else if not ( chr(Val) in OkQuote ) then writeln( 'Illegal quote character') else if chr(Val) in Quotes then writeln( 'Character is already in use as another quote' ) else Quote := chr( Val ); end; procedure SetSOH( Arg : String; var SOH : char ); var Val : integer; begin Val := CtrlChar( Arg ); if Val=-1 then writeln( 'Start-of-packet ordinal value is not numeric!' ) else if not ( Val in [0..31,127,128..159,255]) then writeln ('Start-of-packet character must be a control character!') else SOH := chr( Val ); end; procedure SetTimeOut( Arg : String; var TimeOut : integer ); var Val : integer; handler NotInt; begin writeln('Timeout interval not numeric!'); exit( SetTimeOut ); end; begin if Arg='' then TimeOut := 0 else begin Val := StrToInt( Arg ); if not (Val in [0..94]) then writeln( 'Illegal timeout interval!') else TimeOut := Val; end; end; procedure SetEOL( Arg : String; var EOL : char ); var Val : integer; begin Val := CtrlChar( Arg ); if Val=-1 then writeln( 'End-of-line ordinal value is not numeric!' ) else EOL := chr( Val ); end; procedure SetNPad( Arg : String; var NPad : integer ); var Val : integer; handler NotInt; begin writeln('Padding value not numeric!'); exit( SetNPad ); end; begin Val := StrToInt( Arg ); if not (Val in [0..94]) then writeln( 'Illegal padding value!') else NPad := Val; end; procedure SetPadChar( Arg : String; var PadChar : char ); var Val : integer; begin Val := CtrlChar( Arg ); if Val=-1 then writeln( 'Pad character ordinal value is not numeric!' ) else PadChar := chr( Val ); end; procedure ShowKey( Ch : char ); begin if Land( ord( Ch ), #200 ) <>0 then begin write( 'CTRL-' ); ch := chr( land( ord( ch ), #177 ) ); end; if Ch='' then write('OOPS') else if Ch='' then write('INS') else if Ch=' ' then write('TAB') else if Ch='' then write('HELP') else if Ch='' then write('DEL') else if Ch='' then write('BACKSPACE') else begin if Ch in ['A'..'Z'] then write( 'SHIFT-' ); write( Ch ); end; end; procedure SetEscChar( Arg : String ); var Val : integer; begin if Arg='' then begin IOKeyClear; write( 'Press the key which you want as escape character:' ); while IOCRead( KeyBoard, EscKey ) <> IOEIOC do ; writeln; write( 'Escape character set as: '); ShowKey( EscKey ); writeln; end else begin Val := CtrlChar( Arg ); if Val=-1 then writeln( 'Escape character ordinal value is not numeric!') else EscKey := chr( Val ); end; end; procedure DoSetSend( PList : pPListEntry ); var TempQuote : set of char; begin with PList^ do case recast( Selection, SendRecType ) of SRPacketLength: SetPSize( NextPList^.Arg, SendPSize ); SRCtlQuote: begin TempQuote := Quotes; Quotes := []; { SendQuote may be same as 8-bi or repeat } SetQuote( NextPList^.Arg, SendQuote ); Quotes := TempQuote; end; SRStartOfPacket:SetSOH( NextPList^.Arg, SendSOH ); SRTimeOut: SetTimeOut( NextPList^.Arg, SendTimeOut ); SREndOfLine: SetEOL( NextPList^.Arg, SendEOL ); SRPadding: SetNPad( NextPList^.Arg, SendNPad ); SRPadChar: SetPadChar( NextPList^.Arg, SendPadChar ); otherwise: ; end; end; procedure DoSetReceive( PList : pPListEntry ); begin with PList^ do case recast( Selection, SendRecType ) of SRPacketLength: SetPSize( NextPList^.Arg, RecPSize ); SRCtlQuote: begin Quotes := Quotes - [RecQuote]; SetQuote( NextPList^.Arg, RecQuote ); Quotes := Quotes + [RecQuote]; end; SRStartOfPacket:SetSOH( NextPList^.Arg, RecSOH ); SRTimeOut: SetTimeOut( NextPList^.Arg, RecTimeOut ); otherwise: ; end; end; procedure DoTruncation( PList : pPListEntry ); var NewTrunc : integer; NewTList : TListType; handler NotInt; begin writeln('Truncation value must be an integer!'); exit( DoTruncation ); end; begin with PList^ do if Arg='' then NumTrunc := OldTrunc else begin NewTrunc := 0; EatSpaces( Arg ); while Arg<>'' do begin NewTrunc := NewTrunc + 1; NewTList[NewTrunc] := StrToInt( Arg ); EatSpaces( Arg ); if Arg<>'' then if Arg[1]=',' then Delete( Arg, 1, 1 ); EatSpaces( Arg ); end; NumTrunc := NewTrunc; OldTrunc := NewTrunc; TruncList := NewTList; end; end; procedure DoSetFHeader( PList : pPListEntry ); Const NordWarning = 'Warning: NORD transformation is ON!'; AsLongAs = 'is temporarily active for as long as NORD is ON in any case!'; begin with PList^ do case recast( Selection, FHeaderType ) of FHNord: Nord := recast( NextPList^.Selection, OnOffType) =On; FHNoTrunc: begin OldTrunc := NumTrunc; NumTrunc := 0; if Nord then begin writeln( NordWarning ); writeln(' NO-TRUNCATE ', AsLongAs ); writeln; end; end; FHTrunc: begin DoTruncation( NextPList ); if Nord then begin writeln( NordWarning ); write (' TRUNCATE will not take effect until'); writeln(' NORD is turned OFF!'); writeln; end; end; FHTrans: begin Translate := recast( NextPList^.Selection, TransType ); if Nord then begin writeln( NordWarning ); writeln( ' CONVERT UPPER ', AsLongAs ); writeln; end; end; otherwise: ; end; end; procedure DoSet8Quote( PList : pPListEntry ); var ch : char; begin Quotes := Quotes - [Bit8Quote]; if PList^.Arg='' then Bit8Quote := '&' else begin ch := PList^.Arg[1]; if ch in OkQuote then begin if ch in Quotes then writeln ('Character is already in use as another quote' ) else Bit8Quote := ch; end else writeln('Illegal quote character!'); end; Quotes := Quotes + [Bit8Quote]; end; procedure DoSetRepFix( PList : pPListEntry ); var ch : char; begin Quotes := Quotes - [RepFix]; if PList^.Arg='' then RepFix := '&' else begin ch := PList^.Arg[1]; if ch in OkQuote then begin if ch in Quotes then writeln ('Character is already in use as another quote' ) else RepFix := ch; end else writeln('Illegal quote character!'); end; Quotes := Quotes + [RepFix]; end; procedure SetCommand( PList : pPListEntry ); var SetParm : SetCommType; begin SetParm := recast( PList^.Selection, SetCommType ); PList := PList^.NextPList; case SetParm of SetStop: begin StopBits := recast( PList^.Selection, StopType ); RefreshStopBits; end; SetParity: begin Parity := recast( PList^.Selection, ParityType ); RefreshParity; end; SetBaud: begin Baud := recast( PList^.Selection, SpeedType); RefreshBaud; end; SetFileWarning: begin FileWarning := recast( PList^.Selection, OnOffType ) = On; end; SetLog: begin FileSave := recast( PList^.Selection, OnOffType ) = On; end; SetLogFile: begin SetSaveFile( PList^.Arg ); end; SetDebugging: begin Debug := recast( PList^.Selection, OnOffType ) = On; end; SetSend: DoSetSend( PList ); SetReceive: DoSetReceive( PList ); SetFileHeader: DoSetFHeader( PList ); Set8BitQuote: DoSet8Quote( PList ); SetUse8BitQuote: Use8Quote := recast( PList^.Selection, OnOffType ) = On; SetRepFix: DoSetRepFix( PList ); SetUseRepFix: UseRepFix := recast( PList^.Selection, OnOffType ) = On; SetRetry: DoSetRetry( PList ); SetBreakTime: writeln('Send break is not implemented!'); SetEscape: SetEscChar( PList^.Arg ); otherwise: writeln('Bad SET alternative: ', ord( SetParm ) ); end; end; procedure ShowOnOff( OnValue : boolean ); begin if OnValue then write('ON') else write('OFF'); end; procedure ShowStop; begin if StopBits=SyncrCmd then writeln( 'SYNCHRONOUS mode, no stop bits' ) else begin write('Number of STOP-BITS = '); case StopBits of Stop1Cmd: writeln('1'); Stop1x5Cmd: writeln('1.5'); Stop2Cmd: writeln('2'); otherwise: writeln('invalid, code: ',ord(StopBits)); end; end; end; procedure ShowParity; begin write( 'PARITY check/generation = ' ); case Parity of NoKParity: writeln('NONE'); EvenKParity: writeln('EVEN'); OddKParity: writeln('ODD'); MarkKParity: writeln('MARK (1)'); SpaceKParity: writeln('SPACE (0)'); otherwise: writeln('invalid, code: ',ord(Parity)); end; end; procedure ShowBaud; begin write( 'BAUDrate = ' ); case Baud of SP110: write('110'); SP150: write('150'); SP300: write('300'); SP600: write('600'); SP1200: write('1200'); SP2400: write('2400'); SP4800: write('4800'); SP9600: write('9600'); otherwise: writeln('invalid, code: ',ord(Baud)); end; if Baud in [SP110..SP9600] then writeln(' bps'); end; procedure ShowFWarning; begin write( 'FILE-WARNING = '); ShowOnOff( FileWarning ); writeln; end; procedure ShowDebug; begin write( 'DEBUG output = '); ShowOnOff( Debug ); writeln; end; procedure ShowUse8Quote; begin write( 'USE-8-BIT-QUOTE = '); if Use8Quote then write('AUTO') else write('OFF'); writeln; end; procedure ShowUseRepFix; begin write( 'USE-REPEAT-PREFIX = '); if UseRepFix then write('AUTO') else write('OFF'); writeln; end; procedure ShowLog; begin write( 'LOG session to file = ' ); ShowOnOff( FileSave ); writeln; end; procedure ShowLFile; begin if SaveFile='' then writeln('No log file active') else writeln('LOG-FILE = ',SaveFile); end; procedure DisplayChar( Ch : Char ); var Ch1 : char; begin Ch1 := Chr( LAnd( Ord( Ch ), #177 ) ); if ch1<' ' then write( 'Ctrl-', Ctl( Ch1 ) ) else if ord(Ch1)=177 then write( 'DEL' ) else write('''',Ch1,''''); if Ch<>Ch1 then write(' (Hi bit=1)'); end; procedure Show8Quote; begin write('8-BIT-QUOTE = '); DisplayChar( Bit8Quote ); writeln; end; procedure ShowRepFix; begin write('REPEAT-PREFIX = '); DisplayChar( RepFix ); writeln; end; procedure ShowEscChar; begin write('ESCAPE-CHARACTER = '); ShowKey( EscKey ); writeln; end; procedure ShowPSize( PSize : integer ); begin writeln(' max. PACKET-LENGTH = ', PSize:2 ); end; procedure ShowTOut( TimeOut : integer ); begin writeln(' TIME-OUT after ',TimeOut:2,' seconds'); end; procedure ShowQuote( Quote : char ); begin writeln(' control QUOTE = ''',Quote,''''); end; procedure ShowSOH( SOH : char ); begin write(' START-OF-PACKET = '); DisplayChar( SOH ); writeln; end; procedure ShowEOL( EOL : char ); begin write(' END-OF-LINE = '); DisplayChar( EOL ); writeln; end; procedure ShowPad( Padding : integer ); begin writeln(' PADDING between packets = ', Padding:2,' characters'); end; procedure ShowPChar( PadChar : char ); begin write(' PADCHAR = '); DisplayChar( PadChar ); writeln; end; procedure ShowSend; begin writeln( 'SEND parameters:'); ShowPSize( SendPSize ); ShowTOut( SendTimeOut ); ShowQuote( SendQuote ); ShowSOH( SendSOH ); ShowEOL( SendEOL ); ShowPad( SendNPad ); ShowPChar( SendPadChar ); end; procedure ShowReceive; begin writeln( 'RECEIVE parameters:'); ShowPSize( RecPSize ); ShowTOut( RecTimeOut ); ShowQuote( RecQuote ); ShowSOH( RecSOH ); end; procedure ShowFHeader; var I : integer; begin writeln( 'FILE-HEADER transformations: '); write( ' NORD transformation = '); if Nord then begin writeln( ' ON'); writeln( ' (temporary NO-TRUNCATE and CONVERT UPPER)'); end else begin writeln( ' OFF'); if NumTrunc=0 then writeln(' NO-TRUNCATE of file name') else begin write(' TRUNCATE file name '); write( TruncList[1]:1 ); for i := 2 to NumTrunc do write( ',', TruncList[I]:1 ); writeln; end; if Translate=TransOff then writeln(' CONVERT OFF') else begin write(' CONVERT file name into '); case Translate of TransUpper: writeln('UPPER case'); TransLower: writeln('LOWER case'); otherwise: writeln('<illegal parameter value>'); end; end; end; end; procedure ShowRetry; begin writeln( 'RETRY limits:'); writeln( ' INITIAL-CONNECTION = ',MaxTryInit:2); writeln( ' PACKET = ',MaxTryPack:2); writeln( ' COMMANDS = ',MaxTryComm:2); end; procedure ShowCommand( PList : pPListEntry ); var SetParm : SetCommType; begin SetParm := recast( PList^.Selection, SetCommType ); PList := PList^.NextPList; writeln; case SetParm of SetStop: ShowStop; SetParity: ShowParity; SetBaud: ShowBaud; SetFileWarning: ShowFWarning; SetLog: ShowLog; SetLogFile: ShowLFile; SetDebugging: ShowDebug; SetSend: ShowSend; SetReceive: ShowReceive; SetFileHeader: ShowFHeader; Set8BitQuote: Show8Quote; SetUse8BitQuote: ShowUse8Quote; SetRepFix: ShowRepFix; SetUseRepFix: ShowUseRepFix; SetRetry: ShowRetry; SetBreakTime: writeln('Send break is not implemented!'); SetEscape: ShowEscChar; SetNotFound: begin ShowStop; ShowParity; ShowBaud; ShowFWarning; ShowLog; ShowLFile; ShowDebug; ShowSend; ShowReceive; ShowFHeader; Show8Quote; ShowUse8Quote; ShowRepFix; ShowUseRepFix; ShowRetry; ShowEscChar; end; otherwise: writeln('Bad SHOW alternative: ', ord( SetParm ) ); end; writeln; end; procedure StatusCommand; begin end; procedure SetInitPars( var Pack : Packet ); { Build SendInit packet } var PackLen : integer; begin with Pack do begin adjust( Data, 100 ); data[1] := ToChar(chr(RecPSize )); { Max. packet length I handle } data[2] := ToChar(chr(RecTimeOut)); { When I want to be timed out } data[3] := ToChar(chr(RecNPad )); { How much padding I need } data[4] := ctl (chr(RecPadChar)); { My padding character } data[5] := ToChar(chr(RecEOL) ); { End-of-line I want } data[6] := RecQuote ; { control-quote char I want } data[8] := '1'; { Only 1-char checksum } if (not Use8Quote) or (Parity=NoKParity) then data[7] := 'N' { No need to use 8-bit quote } else data[7] := Bit8Quote ; { 8-bit-quote char I want } if not UseRepFix then data[9] := ' ' { Won't use repeat prefix } else data[9] := RepFix; { Repeat prefix I want } PackLen := 9; if Data[9]=' ' then begin PackLen := 8; if Data[8]='1' then begin PackLen := 7; if Data[7] in [' ','N'] then begin PackLen := 6; end; end; end; Count := ToChar ( chr( PackLen + 3 ) ); adjust( Data, PackLen + 1 ); ptype:= PackToCh( SInitPack ); end; end; procedure ReadPars ( VAR Pack : Packet ); { Set parameters according to Pack (Which is SendInit or Acknowledge packet) and build the corresponding Acknowledge packet } VAR i,PackLen : integer; begin with Pack do if not ( ChToPack(Ptype) IN [SInitPack,ACKPack] ) then begin CurrState := AbortAll; LocalError ( '?Attempted to read parameters from non-send-init packet' ); end else begin adjust( Data, 100 ); PackLen := ord( UnChar( count ) ) - 3; for i := PackLen + 1 to MaxString do Data[i] := ' '; { Don't have to agree on the following parameters } if UnChar( Data[1] ) = chr(0) then SendPSize := 96 else SendPSize := ord ( UnChar ( Data[1] ) ); data[1] := ToChar( chr( RecPSize ) ); SendTimeOut := ord ( UnChar ( Data[2] ) ); data[2] := ToChar( chr(RecTimeOut) ); { SendNPad := ord ( UnChar ( Data[3] ) ); } data[3] := ToChar( chr(RecNPad) ); if UnChar(Data[4])=chr(0) then SendPadChar := chr(0) else SendPadChar := Ctl ( Data[4] ) ; data[4] := ctl( RecPadChar ); if UnChar(Data[5])=chr(0) then SendEOL := chr(13) else SendEOL := UnChar ( Data[5] ) ; data[5] := ToChar( RecEOL ); if UnChar(Data[5])=chr(0) then SendQuote := '#' else SendQuote := Data[6] ; data[6] := RecQuote; { On this one, we have to agree, else there will be no 8-bit quoting } if not ( (Data[7] in (OkQuote + ['Y'])) and Use8Quote ) then begin { Default, if not acceptable 8-bit quote character } NowUse8Quote := FALSE; Data[7] := 'N'; { I agree NOT to do 8-bit quoting } end else begin NowUse8Quote := TRUE; { Only if this Kermit is sending: } if Data[7]<>'Y' then { 'Y' means my request to use } Bit8Quote := Data[7]; { 8-bit quoting is accepted } { Else: use proposed quote char } Data[7] := 'Y'; { I agree to do 8-bit quoting } end; { Checksum type : Default is 1-character checksum } Data[8] := '1'; { Not supporting 2 or 3-character checksums yet } { Repeat prefix : have to agree, else no repeat prefixing } if not ( (Data[9] in OkQuote) and UseRepFix ) then begin { Default, if not acceptable repeat prefix } NowUseRepFix := FALSE; Data[9] := ' '; { I won't do repeat prefixing } end else begin NowUseRepFix := TRUE; { repeat prefix is accepted } RepFix := Data[9]; { agree by returning same value } end; if (Bit8Quote=SendQuote) and NowUse8Quote then begin LocalError('?Cant send same 8-bit quote and control quote'); LocalError(' Denies 8-bit quoting!' ); Data[7] := ' '; NowUse8Quote := false; end; if (RepFix=SendQuote) and NowUseRepFix then begin LocalError('?Cant send same repeat prefix and control quote'); LocalError(' Denies repeat prefixing!'); Data[9] := ' '; NowUseRepFix := false; end; if (RepFix=Bit8Quote) and NowUseRepFix and NowUse8Quote then begin LocalError('?Cant send same repeat prefix and 8-bit quote'); LocalError(' Denies repeat prefixing!'); Data[9] := ' '; NowUseRepFix := false; end; PackLen := 9; if Data[9]=' ' then begin PackLen := 8; if Data[8]='1' then begin PackLen := 7; if Data[7] in [' ','N'] then begin PackLen := 6; end; end; end; Count := ToChar ( chr( PackLen + 3 ) ); adjust( Data, PackLen + 1 ); Ptype := PackToCh ( ACKPack ); end; end; procedure InitParameters; { Abstract: This procedure initializes various global Kermit variables: "Constants", Transmission parameters, Kermit state variables. NB! This procedure is to be called only ONCE during the run! } begin SaveFile := ''; LegalPackets := ['D','Y','N','S','B','F','Z','E','R','C','G','X']; { What I expect he will want } SendSOH := chr(1); SendPSize := 94; { - max. packet size } SendTimeOut := 5; { - 5 seconds timeout } SendNPad := 0; { - no padding } SendPadChar := chr(0); { - ASCII NUL as padchar } SendEOL := chr(13); { - carriage return as eol } SendQuote := '#'; { - sharp as control quote } { What I want from him (parameters which will be used when I send-initiate) } RecSOH := chr(1); RecPSize := 59; { for a Perq with standard buffersize } RecTimeOut := 5; { time-out I want } RecNPad := 0; { Need no padding } RecPadChar := chr(0); RecEOL := chr(13); { Standard End-Of-Line } RecQuote := '#'; { Standard control quote } { What to do about 8-bit quoting } Use8Quote := FALSE; { 8-bit quoting disabled } NowUse8Quote := Use8Quote; Bit8Quote := '&'; UseRepFix := FALSE; { Repeat prefixing disable } NowUseRepFix := UseRepFix; RepFix := '~'; LongWait := 4; { Multiplication factor for TimeOut } { during SendFileHeader (to allow for opening file) } LocalKermit := FALSE; { This frog is born a remote kermit } DisableTimOut := FALSE; { Allow partner to enable timeout } FileWarning := TRUE; { Do not write over existing files } FileSave := FALSE; Debug := FALSE; Nord := FALSE; { Not NORD transformation } TruncList[1] := 8; TruncList[2] := 3; NumTrunc := 2; { Truncate file name 8+3 } OldTrunc := NumTrunc; Translate := TransUpper; { Translate file names to upper case } CurrState := Complete; { Avoid starting out in a bad state } N := 0; { Start out with packet zero } NumTry := 0; OldTry := 0; MaxTryInit := 8; { Retries before giving up } MaxTryPack := 5; MaxTryComm := 3; EscKey := chr( ord(']')+128 ); { Control - ] } { Then some useful character sets : NB! they are recomputed by ReadPars } { This is the set which the set of control characters is mapped into by the Ctl function } CtlMapping := [ ctl( chr( 0) )..ctl( chr( 31) ), ctl( chr(127) ), ctl( chr(128) )..ctl( chr(31+128) ), ctl( chr(255) )]; { Valid quote characters, i.e all printable characters which Ctl does not map a control character into } OkQuote := ['!'..'~'] - CtlMapping; Quotes := [RecQuote, Bit8Quote, RepFix]; end; {=============================================================================} procedure CleanupParameters; begin SetSaveFile( '' ); { force close of previous SaveFile } end.